home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
OUTMAN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
57KB
|
1,542 lines
UNIT OutMan;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Outbound manager Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32;
PROCEDURE OutboundManager;
IMPLEMENTATION
USES Dos, OpCrt, OpString, OpWindow, OpRoot, OpDos, OpCmd, OpKey,
MailUtil, UnixDate, FileUtil, Display, StrUtil, Input, Keyboard,
OutUtil, InterCom, OproUtil, NetFile, Resource, SimpDB, Globals,
LogFile, Util, ArcView, PoPTypes;
TYPE
OutboundPtrType= ^OutboundEntry;
OutboundEntry = Object(DoubleListNode)
Address : TFidoAddress;
Path : PathStr;
Name : S12;
Typ,
Stat : Char;
Siz : LongInt;
DoAfter : String[1];
Marked : Boolean;
Constructor Init;
END;
CONSTRUCTOR OutboundEntry.Init;
BEGIN
IF Not DoubleListNode.Init THEN Fail;
Address.Zone:=0; Address.Net:=0; Address.Node:=0; Address.Point:=0;
Path:=''; Name:=''; typ:=#0; Stat:=#0;
Siz:=0; DoAfter:=''; Marked:=False;
END;
PROCEDURE OutboundManager;
CONST
Attach : String[6] = 'HDFCI ';
Mail : String[6] = 'HDOCI ';
VAR
NodeStr : S13;
Outbound : DoubleList;
FirstLine, OutboundPtr : OutboundPtrType;
l, Linie : Byte;
Temp, Temp3 : windowptr;
MarkCount : Word;
FUNCTION AddressFileName(OPtr: OutboundPtrType): PathStr;
BEGIN
AddressFileName:=HoldFileName(OPtr^.Address,False);
END;
FUNCTION GlobalCmdMenu(VAR escaped : Boolean) : Byte;
VAR
m : TPoPMenu;
LastCmd,
Key : Word;
BEGIN
GetMenu(MnuOMGlobalCmd,3,m);
m.ProcessMenu(Key, LastCmd);
Escaped:=(LastCmd=ccQuit);
GlobalCmdMenu:=key;
END;
FUNCTION GetUpdateType(VAR escaped : Boolean) : Char;
VAR
m : TPoPMenu;
LastCmd,
Key : Word;
BEGIN
GetMenu(MnuOMGetUpdType,3,m);
m.ProcessMenu(Key, LastCmd);
Escaped:=(LastCmd=ccQuit);
CASE Key OF
1 : GetUpdateType:='+';
2 : GetUpdateType:='-';
END;
END;
FUNCTION SelectSendType(VAR escaped : Boolean) : Byte;
VAR
m : TPoPMenu;
LastCmd,
key : Word;
BEGIN
GetMenu(MnuOMSelSendAs,3,m);
m.ProcessMenu(Key, LastCmd);
Escaped:=(LastCmd=ccQuit);
SelectSendType:=Byte(key);
END;
PROCEDURE InsertEntry;
VAR
NewOutbound : OutboundPtrType;
TmpAdr : TFidoAddress;
BEGIN
NewOutbound:=OutboundPtr;
IF Outbound.Head = NIL THEN
BEGIN
Outbound.Append(OutboundPtr);
END ELSE
BEGIN
TmpAdr:=OutboundPtr^.Address;
OutboundPtr:=OutboundPtrType(Outbound.Head);
WHILE (OutboundPtr<>Nil) AND (Address2Sort(OutboundPtr^.Address)<Address2Sort(TmpAdr)) DO
BEGIN
OutboundPtr:=OutboundPtrType(Outbound.Next(OutboundPtr));
END;
IF OutboundPtr=NIL THEN
OutBound.Append(NewOutBound)
ELSE
Outbound.PlaceBefore(NewOutbound, OutboundPtr);
END;
OutboundPtr:=NewOutbound;
END;
PROCEDURE WriteLine(OPtr: OutboundPtrType; Linie: Byte; Current: BOOLEAN);
VAR
BeforePtr : OutboundPtrType;
Attr : BYTE;
BEGIN
IF OPtr=NIL THEN Exit;
BeforePtr:=OutboundPtrType(Outbound.Prev(OPtr));
Attr:=CorrectAttribute(2,Current,OPtr^.Marked);
IF (Linie=2) OR (BeforePtr=Nil) OR Not CmpAdr(OPtr^.Address,BeforePtr^.Address) THEN
BEGIN
NodeStr:=Address2Str(OPtr^.Address) ;
Temp^.wFastWrite(' '+CPad(NodeStr,13), Linie, 1, Attr);
END ELSE
Temp^.wFastWrite(' - ', Linie, 1, Attr);
CASE OPtr^.typ OF
'O' : Temp^.wFastWrite('OLDREQ ', Linie, 15, Attr);
'U' : Temp^.wFastWrite('UPDREQ ', Linie, 15, Attr);
'R' : Temp^.wFastWrite('F. REQ ', Linie, 15, Attr);
'B' : Temp^.wFastWrite('BUNDLE ', Linie, 15, Attr);
'M' : Temp^.wFastWrite('MAIL ', Linie, 15, Attr);
'F' : Temp^.wFastWrite('ATTACH ', Linie, 15, Attr);
'Z' : Temp^.wFastWrite('UNDIAL ', Linie, 15, Attr);
'P' : Temp^.wFastWrite('POLL ', Linie, 15, Attr);
'W' : Temp^.wFastWrite('B.WAZO ', Linie, 15, Attr);
END;
CASE OPtr^.stat OF
'O',
'F' : Temp^.wFastWrite('NORMAL ', Linie, 23, Attr);
'C' : Temp^.wFastWrite('CRASH ', Linie, 23, Attr);
'H' : Temp^.wFastWrite('HOLD ', Linie, 23, Attr);
'D' : Temp^.wFastWrite('DIRECT ', Linie, 23, Attr);
'I' : Temp^.wFastWrite('IMPORT. ', Linie, 23, Attr);
ELSE Temp^.wFastWrite(' ', Linie, 23, Attr);
END;
IF (OPtr^.typ = 'M') AND (OPtr^.siz = 0) THEN
Temp^.wFastWrite('Missing ', Linie, 31, Attr)
ELSE
IF NOT(OPtr^.typ IN ['R', 'U', 'O', 'Z']) THEN
BEGIN
Temp^.wFastWrite(LongIntForm('#######',OPtr^.siz)+' ', Linie, 31, Attr);
END ELSE
Temp^.wFastWrite(' ', Linie, 31, Attr);
Temp^.wFastWrite(CPad(OPtr^.path+OPtr^.Name,39), Linie, 40, Attr);
Temp^.wFastWrite(OPtr^.DoAfter, Linie,78,Attr);
END;
PROCEDURE WriteOutbound;
VAR
SaveOutBound : OutboundPtrType;
num, a : Byte;
BEGIN
SaveOutBound:=FirstLine;
Num:=2;
WHILE (FirstLine<>NIL) AND (Num<ScreenHeight-4) DO
BEGIN
IF FirstLine=OutboundPtr THEN
BEGIN
WriteLine(FirstLine, num,FALSE);
Linie:=Num;
END ELSE
WriteLine(FirstLine, num,FALSE);
FirstLine:=OutboundPtrType(outbound.next(FirstLine));
Inc(Num);
END;
FOR a:=Num TO ScreenHeight-5 DO
BEGIN
GOTOXY(1, a); CLREOL;
END;
FirstLine:=SaveOutBound;
END;
PROCEDURE BrowseList;
VAR
TmpPtr : OutboundPtrType;
InKey : Word;
PROCEDURE UnmarkAll;
VAR
TmpPtr : OutboundPtrType;
BEGIN
IF MarkCount>0 THEN
BEGIN
TmpPtr:=OutboundPtrType(Outbound.Head);
WHILE TmpPtr<>Nil DO
BEGIN
TmpPtr^.Marked:=False;
TmpPtr:=OutboundPtrType(Outbound.Next(TmpPtr));
END;
MarkCount:=0;
END;
WriteOutbound;
END;
PROCEDURE AdjustFirstLine;
BEGIN
FirstLine:=OutboundPtr;
WHILE (Outbound.Prev(FirstLine)<>Nil) And (Linie>2) DO
BEGIN
Dec(Linie);
FirstLine:=OutboundPtrType(Outbound.Prev(FirstLine));
END;
UnMarkAll;
END;
PROCEDURE SendFile;
VAR
FNum, i : Byte;
OutAddress : TFidoAddress;
p, Mask : PathStr;
FilesToSend : ARRAY[1..20] OF RECORD
FName : PathStr;
SendType : Byte;
END;
Escaped : Boolean;
Ch : Char;
FName : String[12];
Ext : String[4];
Srec : SEARCHREC;
BEGIN
Ch:=Attach[SelectMailType(escaped,1550)];
IF escaped THEN Exit;
OutAddress.Zone:=cfg.Addresses[Cfg.MainAdrNum].Zone;
OutAddress.Net:=cfg.Addresses[Cfg.MainAdrNum].Net;
OutAddress.Node:=0;
OutAddress.Point:=0;
IF Not GetConfirmAddress(4,3,OutAddress,1503) THEN Exit;
FillChar(FilesToSend, SizeOf(FilesToSend), 0);
FNum:=1;
Mask:='*.*';
REPEAT
FilesToSend[FNum].SendType:=SelectSendType(escaped);
IF escaped And (FNum=1) THEN Exit;
IF Not Escaped THEN
BEGIN
IF SelectFile(Mask) THEN FilesToSend[FNum].FName:=Mask;
IF FilesToSend[FNum].FName = '' THEN
BEGIN
IF FNum=1 THEN Exit;
END;
Mask:=AddBackSlash(JustPathName(Mask))+'*.*' ;
END;
Inc(FNum);
UNTIL (FNum=21) OR (FilesToSend[FNum-1].FName='');
WHILE FilesToSend[FNum].FName='' DO Dec(FNum);
FOR i:=1 TO FNum DO
SendAFile(FilesToSend[i].FName, OutAddress, Ch, FilesToSend[i].SendType);
FOR i:=1 TO FNum DO
BEGIN
New(OutboundPtr,Init);
IF OutboundPtr<>NIL THEN
BEGIN
WITH OutboundPtr^ DO
BEGIN
FSplit(FilesToSend[i].FName, p, FName, ext);
Name:=FName+ext;
Address:=OutAddress;
Stat:=Ch;
DoAfter:=STypeArray[FilesToSend[i].SendType];
FINDFIRST(FilesToSend[i].FName, AnyFile, Srec);
IF DOSERROR = 0 THEN
siz:=Srec.size
ELSE
siz:=0;
path:=p;
typ:='F';
FindClose(Srec);
END;
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
END;
AdjustFirstLine;
END;
PROCEDURE RequestFile;
VAR
ReqAddress : TFidoAddress;
ReqFiles : ARRAY[1..20] OF RECORD
FName : String[15];
Password: String[20];
END;
escaped : Boolean;
i,FNum : Byte;
Ch : Char;
BEGIN
FillChar(ReqAddress, SizeOf(ReqAddress), 0);
ReqAddress.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone;
ReqAddress.Net:=Cfg.Addresses[Cfg.MainAdrNum].Net;
IF Not GetConfirmAddress(4,3,ReqAddress,1504) THEN Exit;
Ch:=Attach[SelectMailType(escaped,1551)];
IF escaped THEN Exit;
FillChar(ReqFiles, SizeOf(ReqFiles), 0);
FNum:=1;
REPEAT
IF (NOT InputString(10,5,15,15,3,'Request file','',ReqFiles[FNum].FName)) OR (ReqFiles[FNum].FName = '') THEN
IF FNum=1 THEN Exit ELSE Break;
ReqFiles[FNum].FName:= StUpCase(ReqFiles[FNum].FName);
IF (NOT InputString(24,5,20,20,3,'Passwd','',ReqFiles[FNum].PassWord)) THEN
IF FNum=1 THEN Exit ELSE Break;
INC(FNum);
UNTIL FNum=21;
Dec(FNum);
FOR i:=1 TO FNum DO
IF NOT RequestAFile(ReqFiles[i].FName, ReqAddress, ReqFiles[i].Password) THEN
ReqFiles[i].FName:='';
FOR i:=1 TO FNum DO
BEGIN
IF ReqFiles[i].FName<>'' THEN
BEGIN
New(outboundPtr, Init);
IF OutboundPtr<>NIL THEN
BEGIN
WITH OutboundPtr^ DO
BEGIN
Name:=ReqFiles[i].FName;
Address:=ReqAddress;
typ:='R';
siz:=0;
END;
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
END;
END;
IF MakeAPoll(ReqAddress,Ch) THEN
BEGIN
New(OutboundPtr,Init);
IF OutboundPtr<>NIL THEN
BEGIN
WITH OutboundPtr^ DO
BEGIN
Address:=ReqAddress;
Typ:='P';
Stat:=Ch;
Siz:=0;
END;
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
END;
AdjustFirstLine;
END;
PROCEDURE DeleteEntry;
VAR
BadWaZOORec : TBadWaZOO;
BadWaZOOFile : PSimpDB;
CPtr, TmpPtr : OutboundPtrType;
Srec : SEARCHREC;
Ch : Char;
TempFile : File;
TempFile2 : PBufTextFile;
Count : Byte;
InStr : String;
DoIt, All,
Found, Del : Boolean;
FName : PathStr;
BEGIN
IF (MarkCount=0) And (Outbound.Size>0) THEN
BEGIN
OutboundPtr^.Marked:=True;
Inc(MarkCount);
END;
CPtr:=OutboundPtrType(Outbound.Head);
All:=False;
WHILE CPtr<>Nil DO
BEGIN
IF CPtr^.Marked THEN
BEGIN
DoIt:=True;
IF NOT All THEN
BEGIN
CASE ConfirmAll(' Delete mail for '+Address2Str(CPtr^.Address)+' ?', 10) OF
'Y' : DoIt:=True;
'N' : DoIt:=False;
'A' : All:=True;
END;
END;
IF DoIt THEN
BEGIN
CASE CPtr^.Typ OF
'B' : DeleteFile(HoldAreaPath(CPtr^.Address,False)+CPtr^.Name);
'Z' : WITH CPtr^ DO
RemoveUnDialable(Address);
'W' : BEGIN
New(BadWaZOOFile, Open(StartPath+PoPBadWaZooFileName, SizeOf(TBadWaZOO), False));
IF BadWaZooFile<>Nil THEN
BEGIN
Found:=False;
WHILE NOT Found AND BadWaZooFile^.NextRec(BadWaZOORec, Keep) DO
BEGIN
IF CmpAdr(BadWaZooRec.Address,CPtr^.Address) AND
(CPtr^.Name=BadWaZOORec.NewName) THEN
Found := True
ELSE
BadWaZooFile^.Unlock(BadWaZOOFile^.FilePos-1);
END;
IF Found THEN
BEGIN
DeleteFile(Cfg.Inbound[BadWaZooRec.NodeStat]+BadWaZooRec.NewName);
BadWaZooFile^.DelRec(BadWaZooRec, BadWaZooFile^.FilePos-1);
END;
Dispose(BadWaZOOFile, Close);
END;
END;
ELSE BEGIN
FileMode:=ShareRW+ShareDenyW;
IF (CPtr^.typ IN ['R', 'U', 'O']) THEN
Assign(TempFile, AddressFileName(CPtr)+'REQ')
ELSE
Assign(TempFile, AddressFileName(CPtr)+CPtr^.Stat+'LO');
Reset(TempFile, 1);
New(TempFile2, Init(AddressFileName(CPtr)+'TMP',SCreate,2048));
Found:=False;
Count:=0;
WHILE NOT EoF(TempFile) DO
BEGIN
ReadLine(TempFile, InStr);
IF Copy(InStr,1,1)<>'~' THEN
BEGIN
IF (InStr[1] = '#') OR (InStr[1] = '^') THEN
BEGIN
Del:=True;
Ch:=InStr[1];
Delete(InStr, 1, 1);
END ELSE
Del:=False;
IF Pos(' ', InStr)>0 THEN FName:=Copy(InStr, 1, pos(' ', InStr)-1) ELSE FName:=InStr;
IF ((StUpCase(FName)<>StUpCase(CPtr^.path+CPtr^.Name)) AND
(StUpCase(FName)<>StUpCase(HoldAreaPath(CPtr^.Address,False)+CPtr^.Name)))
OR (Found) THEN
BEGIN
IF Del THEN TempFile2^.WriteLn(Ch+InStr) ELSE TempFile2^.WriteLn(InStr);
Inc(Count);
END ELSE
BEGIN
IF NOT Found THEN
BEGIN
Found:=True;
IF Del And (CPtr^.Siz>0) THEN
BEGIN
DoIt:=True;
IF NOT All THEN
BEGIN
CASE ConfirmAll(' Delete '+CPtr^.Name+' too?', 10) OF
'Y' : DoIt:=True;
'N' : DoIt:=False;
'A' : All:=True;
END;
END;
IF DoIt THEN DeleteFile(InStr);
END;
END;
END;
END;
END;
Close(TempFile); Dispose(TempFile2, Done);
IF CPtr^.typ IN ['R', 'U', 'O'] THEN
BEGIN
DeleteFile(AddressFileName(CPtr)+'REQ');
END ELSE
DeleteFile(AddressFileName(CPtr)+CPtr^.stat+'LO');
IF Count=0 THEN
BEGIN
DeleteFile(AddressFileName(CPtr)+'TMP');
FINDFIRST(AddressFileName(CPtr)+CPtr^.stat+'LO', AnyFile, Srec);
IF DOSERROR = 0 THEN
IF Srec.size = 0 THEN
BEGIN
DeleteFile(AddressFileName(CPtr)+CPtr^.stat+'LO');
END;
FindClose(SRec);
END ELSE
BEGIN
IF (CPtr^.typ IN ['R', 'U', 'O']) THEN
RenameFile(AddressFileName(CPtr)+'TMP', AddressFileName(CPtr)+'REQ')
ELSE
RenameFile(AddressFileName(CPtr)+'TMP', AddressFileName(CPtr)+CPtr^.stat+'LO');
END;
END; {case else}
END;
TmpPtr:=CPtr;
IF Outbound.Next(CPtr)=Nil THEN
CPtr:=OutboundPtrType(Outbound.Prev(CPtr))
ELSE
CPtr:=OutboundPtrType(Outbound.Next(CPtr));
IF FirstLine=TmpPtr THEN FirstLine:=CPtr;
IF TmpPtr=OutboundPtr THEN OutboundPtr:=CPtr;
Outbound.Delete(TmpPtr);
END ELSE
CPtr:=OutboundPtrType(Outbound.Next(CPtr));
END ELSE
CPtr:=OutboundPtrType(Outbound.Next(CPtr));
END;
UnmarkAll;
END;
PROCEDURE MergeBundles(CONST OldName, NewName: PathStr);
VAR
Old,New : TNetFile;
Buffer : Pointer;
BufSize, Got : Word;
Cptr : OutboundPtrType;
BEGIN
Old.Open(OldName, 1, False);
New.Open(NewName, 1, False);
New.Seek(New.FileSize-2);
Old.Seek(SizeOf(TPktHeader));
IF MaxAvail>65000 THEN BufSize:=65000 ELSE BufSize:=MaxAvail;
GetMem(Buffer,BufSize);
REPEAT
Old.BlockReadNum(Buffer^,BufSize,Got);
New.BlockWrite(Buffer^,Got);
UNTIL Got=0;
CPtr:=OutboundPtrType(Outbound.Head);
WHILE (CPtr<>NIL) AND (Cptr^.Typ<>'B') AND (AddressFileName(CPtr)+CPtr^.stat+'UT'<>NewName) DO
Cptr:=OutboundPtrType(Outbound.Next(Cptr));
IF Cptr<>NIL THEN Cptr^.Siz:=New.FILESIZE;
Old.Close; New.Close;
DeleteFile(OldName);
FreeMem(Buffer,BufSize);
END;
PROCEDURE ReAddress;
VAR
OldName,
NewName : PathStr;
Count : Byte;
CPtr : OutboundPtrType;
NewAddress : TFidoAddress;
All, DoIt,
RemoveIt, Del : Boolean;
OldFile,
NewFile, Tmp : PBufTextFile;
InSTr : String;
Ch : Char;
BEGIN
IF ((MarkCount=0) AND (OutboundPtr^.Typ IN ['Z','W'])) OR (Outbound.Size<1) THEN Exit;
NewAddress:=OutboundPtr^.Address;
IF NOT GetConfirmAddress(4,3,NewAddress,1505) OR CmpAdr(NewAddress,OutboundPtr^.Address) THEN Exit;
IF MarkCount=0 THEN
BEGIN
OutboundPtr^.Marked:=True;
Inc(MarkCount);
END;
CPtr:=OutboundPtrType(Outbound.Head);
All:=False;
WHILE CPtr<>Nil DO
BEGIN
RemoveIt:=False;
IF CPtr^.Marked THEN
BEGIN
CASE CPtr^.typ OF
'P' : BEGIN
IF NOT ExistFile(HoldFileName(NewAddress,True)+CPtr^.Stat+'LO') THEN
BEGIN
RenameFile(AddressFileName(CPtr)+CPtr^.stat+'LO',
HoldFileName(NewAddress,True)+CPtr^.stat+'LO');
END ELSE
DeleteFile(AddressFileName(CPtr)+CPtr^.stat+'LO');
END;
'B' : BEGIN
IF NOT ExistFile(HoldFileName(NewAddress,True)+CPtr^.stat+'UT') THEN
BEGIN
RenameFile(AddressFileName(CPtr)+CPtr^.stat+'UT',
HoldFileName(NewAddress,True)+CPtr^.stat+'UT');
END ELSE
BEGIN
DoIt:=True;
IF NOT All THEN
BEGIN
CASE ConfirmAll('Merge bundles', 11) OF
'Y' : DoIt:=True;
'N' : DoIt:=False;
'A' : All:=True;
END;
END;
IF DoIt THEN
BEGIN
MergeBundles(AddressFileName(CPtr)+CPtr^.stat+'UT',
HoldFileName(NewAddress,True)+CPtr^.stat+'UT');
END;
RemoveIt:=True;
END;
{ CPtr^.Name:=JustFileName(HoldFileName(NewAddress,True)+CPtr^.stat+'UT');}
END;
'R',
'U',
'O',
'M',
'F' : BEGIN
IF CPtr^.Typ IN ['R','U','O'] THEN
BEGIN
OldName:=AddressFileName(CPtr)+'REQ';
NewName:=HoldFileName(NewAddress,True)+'REQ';
END ELSE
BEGIN
OldName:=AddressFileName(CPtr)+CPtr^.Stat+'LO';
NewName:=HoldFileName(NewAddress,True)+CPtr^.Stat+'LO';
END;
New(Tmp, Init(AddressFilename(CPtr)+'TMP', SCreate, 2048));
New(OldFile, Init(OldName, SOpenRead+ShareDenyW, 2048));
IF OldFile<>NIL THEN
BEGIN
New(NewFile, InitCreate(NewName, SOpenWrite, 2048));
Count:=0;
WHILE NOT OldFile^.EOF DO
BEGIN
OldFile^.ReadLn(InStr);
IF (InStr[1] = '#') OR (InStr[1] = '^') THEN
BEGIN
Del:=True;
Ch:=InStr[1];
Delete(InStr, 1, 1);
END ELSE
Del:=False;
IF (StUpCase(InStr) <> StUpCase(CPtr^.path+CPtr^.Name)) AND
(StUpCase(InStr) <> StUpCase(HoldAreaPath(CPtr^.Address,False)+CPtr^.Name)) THEN
BEGIN
IF Del THEN Tmp^.WriteLn(Ch+InStr) ELSE Tmp^.WriteLn(InStr);
Inc(Count);
END ELSE
BEGIN
IF Del THEN NewFile^.WriteLn(Ch+InStr) ELSE NewFile^.WriteLn(InStr);
END;
END;
Dispose(OldFile, Done); Dispose(NewFile, Done);
DeleteFile(OldName);
END ELSE
Count:=0;
Dispose(Tmp, Done);
IF Count = 0 THEN
BEGIN
DeleteFile(AddressFilename(CPtr)+'TMP');
END ELSE
BEGIN
IF CPtr^.Typ IN ['R','U','O'] THEN
RenameFile(AddressFileName(CPtr)+'TMP', AddressFileName(CPtr)+'REQ')
ELSE
RenameFile(AddressFileName(CPtr)+'TMP', AddressFileName(CPtr)+CPtr^.stat+'LO');
END;
END;
END;
OutboundPtr:=CPtr;
Outbound.Remove(CPtr);
IF RemoveIt THEN
Dispose(OutboundPtr)
ELSE
BEGIN
WITH OutboundPtr^ DO
BEGIN
Address:=NewAddress;
END;
InsertEntry;
CPtr:=OutboundPtr;
CPtr^.Marked:=False;
END;
CPtr:=OutboundPtrType(Outbound.Head);
END ELSE
CPtr:=OutboundPtrType(Outbound.Next(CPtr));
END;
UnMarkAll;
FirstLine:=OutboundPtrType(Outbound.Head);
OutboundPtr:=FirstLine;
WriteOutbound;
END;
PROCEDURE ChangeStat;
LABEL
NextOne;
VAR
TempFile : File;
TempFile2,
TempFile3 : PBufTextFile;
InStr : String;
Ch : Char;
NewName : S12;
Count, StatNum : Byte;
All, DoIt,
MustRepaint,
Del, Escaped : Boolean;
CPtr : OutboundPtrType;
BEGIN
IF ((MarkCount=0) And (OutboundPtr^.Typ IN ['W','R','U','O','Z'])) Or
(Outbound.Size<1) THEN Exit;
StatNum:=SelectMailType(escaped,1552);
IF Escaped THEN Exit;
IF (MarkCount=0) And (Outbound.Size>0) THEN
BEGIN
OutboundPtr^.Marked:=True;
Inc(MarkCount);
END;
CPtr:=OutboundPtrType(Outbound.Head);
MustRepaint:=False;
All:=False;
WHILE CPtr<>Nil DO
BEGIN
IF CPtr^.Marked And NOT (CPtr^.Typ IN ['W','R','U','O','Z']) THEN
BEGIN
IF CPtr^.Typ='B' THEN
BEGIN
IF Mail[StatNum] = CPtr^.Stat THEN Goto NextOne;
NewName:=Copy(CPtr^.Name, 1, 9)+Mail[StatNum]+'UT';
IF ExistFile(HoldAreaPath(CPtr^.Address,False)+NewName) THEN
BEGIN
DoIt:=True;
IF NOT All THEN
BEGIN
CASE ConfirmAll('Merge bundles', 11) OF
'Y' : DoIt:=True;
'N' : DoIt:=False;
'A' : All:=True;
END;
END;
IF DoIt THEN
BEGIN
MergeBundles(HoldAreaPath(CPtr^.Address,False)+CPtr^.Name,
HoldAreaPath(CPtr^.Address,False)+NewName);
Outbound.Remove(CPtr);
Dispose(CPtr);
CPtr:=OutboundPtrType(Outbound.Head);
OutboundPtr:=CPtr;
FirstLine:=CPtr;
MustRepaint:=True;
Continue;
END;
END ELSE
BEGIN
RenameFile(HoldAreaPath(CPtr^.Address,False)+CPtr^.Name,
HoldAreaPath(CPtr^.Address,False)+NewName);
CPtr^.Name:=NewName;
CPtr^.Stat:=Mail[StatNum];
END ;
END ELSE
BEGIN
IF Attach[StatNum] = CPtr^.stat THEN GOTO NextOne;
Assign(TempFile, AddressFileName(CPtr)+CPtr^.stat+'LO');
FileMode:=ShareRW+ShareDenyW; Reset(TempFile,1);
IF IOResult=0 THEN
BEGIN
New(TempFile2, Init(AddressFileName(CPtr)+'TMP', SCreate, 1024));
New(TempFile3, InitCreate(AddressFileName(CPtr)+Attach[StatNum]+'LO', SOpenWrite+ShareDenyW, 1024));
Count:=0;
WHILE NOT EoF(TempFile) DO
BEGIN
ReadLine(TempFile, InStr);
IF (InStr[1] = '#') OR (InStr[1] = '^') THEN
BEGIN
Del:=True;
Ch:=InStr[1];
Delete(InStr, 1, 1);
END ELSE
Del:=False;
IF (StUpCase(InStr) <> StUpCase(CPtr^.path+CPtr^.Name)) AND
(StUpCase(InStr)<>StUpCase(HoldAreaPath(CPtr^.Address,False)+CPtr^.Name)) THEN
BEGIN
IF Del THEN TempFile2^.WriteLn(Ch+InStr) ELSE TempFile2^.WriteLn(InStr);
Inc(Count);
END ELSE
BEGIN
IF Del THEN TempFile3^.WriteLn(Ch+InStr) ELSE TempFile3^.WriteLn(InStr);
END;
END;
Close(TempFile);
Dispose(TempFile2, Done); Dispose(TempFile3, Done);
DeleteFile(AddressFileName(CPtr)+CPtr^.stat+'LO');
IF Count = 0 THEN
BEGIN
DeleteFile(AddressFileName(CPtr)+'TMP');
END ELSE
BEGIN
RenameFile(AddressFileName(CPtr)+'TMP', AddressFileName(CPtr)+CPtr^.stat+'LO');
END;
END;
CPtr^.Stat:=Attach[StatNum];
END;
END;
NextOne:
CPtr^.Marked:=False;
CPtr:=OutboundPtrType(Outbound.Next(CPtr));
END;
UnmarkAll;
IF MustRepaint THEN WriteOutbound;
END;
PROCEDURE Poll;
VAR
PollAddress : TFidoAddress;
escaped : Boolean;
Ch : Char;
BEGIN
PollAddress.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone;
PollAddress.Net:=Cfg.Addresses[Cfg.MainAdrNum].Net;
PollAddress.Node:=0;
PollAddress.Point:=0;
IF Not GetConfirmAddress(4,3,PollAddress,1506) THEN Exit;
Ch:=Attach[SelectMailType(escaped,1553)];
IF escaped THEN Exit;
IF MakeAPoll(PollAddress, Ch) THEN
BEGIN
New(OutboundPtr, Init);
IF OutboundPtr<>NIL THEN
BEGIN
WITH OutboundPtr^ DO
BEGIN
Name:='';
Address:=PollAddress;
Typ:='P';
Stat:=Ch;
Siz:=0;
END;
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
AdjustFirstLine;
END;
END;
PROCEDURE BundleView(CONST FName: PathStr);
VAR
BundleWin: WindowPtr;
BundleFile : File;
BPos, BytesRead: Word;
Buffer : Pointer;
PROCEDURE WriteBundleHeader;
VAR
BundleHeadRec : TPktHeader;
BEGIN
Move(Buffer^, BundleHeadRec, SizeOf(BundleHeadRec));
WITH BundleHeadRec DO
BEGIN
GotoXY(1,1); WriteLn(' PacketType: ',Filler1,' Packer: ',ProductNames(Product),' SerialNo: ',SerialNo,
' Password: ',AsciiZ2Str(Password,8));
GotoXY(1,2); WriteLn(' To: ',DestZone,':',DestNet,'/',DestNode,' From: ',OrigZone,':',OrigNet,'/',OrigNode,
' Date: ',Day,'/',Month,'-',Year,' ',Hour,':',Min,':',Sec);
END;
END;
BEGIN
IF Not ExistFile(FName) THEN Exit;
MyWin(BundleWin, 1, 2, 80, ScreenHeight, 3, 'Bundle Viewer',False);
Assign(BundleFile, FName); FileMode:=ShareRead+ShareDenyNone;
Reset(BundleFile, 1);
GetMem(Buffer, 8192);
BlockRead(BundleFile,Buffer^, 8192, BytesRead);
Close(BundleFile);
WriteBundleHeader;
BPos:=58;
PopReadKeyWord;
FreeMem(Buffer, 8192);
KillWindow(BundleWin);
END;
PROCEDURE ViewFile;
VAR
AT : ShortInt;
FName : PathStr;
BEGIN
CASE OutboundPtr^.Typ OF
'O',
'U',
'R',
'Z',
'W',
'P' : AskError(12, 'Can''t display this type of file', 3);
'B' : BundleView(HoldAreaPath(OutboundPtr^.Address,False)+OutboundPtr^.Name);
'M',
'F' : BEGIN
IF OutboundPtr^.Typ='M' THEN
FName:=HoldAreaPath(OutboundPtr^.Address,False)
ELSE
FName:=OutboundPtr^.Path;
FName:=FName+OutboundPtr^.Name;
AT:=ArcType(FName);
IF AT<>0 THEN ViewArchive(FName,AT) ELSE AskError(12, 'Unknown archive type', 3);
END;
END;
END;
PROCEDURE FileUpdateRequest;
VAR
Password : String[20];
ReqFile : PBufTextFile;
Srec : SEARCHREC;
mask, FileName, p : PathStr;
n, ext : String[12];
UpdAddress : TFidoAddress;
escaped : Boolean;
Dt : DateTime;
Ch, UpdType : Char;
BEGIN
UpdType:=GetUpdateType(escaped);
IF escaped THEN Exit;
mask:='*.*';
IF NOT InputString(10,5,40,40,3,'Send file name','',mask) THEN Exit;
IF SelectFile(Mask) THEN FileName:=Mask ELSE FileName:='';
IF FileName = '' THEN Exit;
Ch:=Attach[SelectMailType(escaped,1551)];
IF escaped THEN Exit;
Password:='';
IF (NOT InputString(24,5,6,6,3,'Passwd','',PassWord)) THEN Exit;
UpdAddress.Zone:=cfg.Addresses[Cfg.MainAdrNum].Zone;
UpdAddress.Net:=cfg.Addresses[Cfg.MainAdrNum].Net;
UpdAddress.Node:=0;
UpdAddress.Point:=0;
IF Not GetConfirmAddress(4,3,UpdAddress,1504) THEN Exit;
FINDFIRST(FileName, AnyFile, Srec);
FindClose(SRec);
FSplit(FileName, p, n, ext);
New(ReqFile, InitCreate(HoldFileName(UpdAddress,True)+'REQ', SOpenWrite, 256));
UnPackTime(Srec.Time, Dt);
WITH Dt DO
ReqFile^.WriteNoLn(n+ext+' '+UpdType+Long2Str(GetUnixDate(Year, Month, Day, Hour, Min, Sec)));
IF Password='' THEN ReqFile^.WriteLn('') ELSE ReqFile^.WriteLn(' !'+Password);
Dispose(ReqFile, Done);
MakeAPoll(UpdAddress, Ch);
New(OutboundPtr, Init);
IF OutboundPtr<>NIL THEN
BEGIN
WITH OutboundPtr^ DO
BEGIN
Name:=n+ext;
Address:=UpdAddress;
CASE UpdType OF
'+' : typ:='U';
'-' : typ:='O';
END;
stat:=Ch;
siz:=0;
END;
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
AdjustFirstLine;
END;
PROCEDURE GlobalCmd;
CONST
DayType : ARRAY[1..7] Of String[2] = ('MO','TU','WE','TH','FR','SA','SU');
VAR
i, Choice : Byte;
Escaped: Boolean;
Sr1, SRec : SearchRec;
BasePath, OutPath : PathStr;
TmpPtr : OutboundPtrType;
PROCEDURE CleanTheOutbound(CONST Path: PathStr);
VAR
Sr : SearchRec;
DayCount : Byte;
BEGIN
FOR DayCount:=1 TO 7 DO
BEGIN
FindFirst(Path+'\????????.'+DayType[DayCount]+'?',AnyFile,Sr);
WHILE DosError=0 DO
BEGIN
IF (Sr.Size=0) THEN DeleteFile(Path+'\'+Sr.Name);
FindNext(Sr);
END;
FindClose(Sr);
END;
END;
BEGIN
{Clean outbound, remove undialables, }
Choice:=GlobalCmdMenu(Escaped);
IF Escaped THEN Exit;
CASE Choice OF
1: BEGIN
i:=Length(JustFileName(cfg.outbound));
BasePath:=Copy(Cfg.Outbound, 1, Length(Cfg.Outbound)-i);
FindFirst(cfg.outbound+'.*', Directory, Srec);
WHILE DOSError=0 DO
BEGIN
OutPath:=BasePath+SRec.Name;
CleanTheOutbound(OutPath);
FindFirst(OutPath+'\????????.PNT', Directory, Sr1);
WHILE DOSError=0 DO
BEGIN
CleanTheOutbound(OutPath+'\'+Sr1.Name);
IF NOT Cfg.KeepEmptyDirs THEN
BEGIN
RmDir(OutPath+'\'+Sr1.Name);
IF IOResult<>0 THEN ;
END;
FindNext(Sr1);
END;
FindClose(Sr1);
IF OutPath<>Cfg.Outbound THEN
BEGIN
RmDir(OutPath);
IF IOResult<>0 THEN ;
END;
FindNext(SRec);
END;
FindClose(SRec);
END;
2: IF DeleteFile(StartPath+PoPUndialFileName) THEN
BEGIN
OutboundPtr:=OutboundPtrType(Outbound.Head);
WHILE OutboundPtr<>Nil DO
BEGIN
TmpPtr:=OutboundPtr;
OutboundPtr:=OutboundPtrType(Outbound.Next(OutboundPtr));
IF TmpPtr^.Typ='Z' THEN Outbound.Delete(TmpPtr);
END;
END;
END;
UnMarkAll;
OutboundPtr:=OutboundPtrType(OutBound.Head);
FirstLine:=OutboundPtr;
WriteOutbound;
END;
BEGIN
REPEAT
Topic:=61;
WriteLine(OutboundPtr, Linie,TRUE);
InKey:=PopReadKeyWord;
WriteLine(OutboundPtr, Linie,FALSE);
CASE Char(Lo(Inkey)) OF
'+' : IF Outbound.Size>0 THEN
BEGIN
TmpPtr:=OutboundPtrType(Outbound.Head);
WHILE TmpPtr<>Nil DO
BEGIN
IF CmpAdr(OutboundPtr^.Address,TmpPtr^.Address) And Not(TmpPtr^.Marked) THEN
BEGIN
TmpPtr^.Marked:=True;
Inc(MarkCount);
END;
TmpPtr:=OutboundPtrType(Outbound.Next(TmpPtr));
END;
WriteOutbound;
END;
'-' : IF Outbound.Size>0 THEN
BEGIN
TmpPtr:=OutboundPtrType(Outbound.Head);
WHILE TmpPtr<>Nil DO
BEGIN
IF CmpAdr(OutboundPtr^.Address,TmpPtr^.Address) And (TmpPtr^.Marked) THEN
BEGIN
TmpPtr^.Marked:=False;
Dec(MarkCount);
END;
TmpPtr:=OutboundPtrType(Outbound.Next(TmpPtr));
END;
WriteOutbound;
END;
#13 : IF Outbound.Size>0 THEN
BEGIN
OutboundPtr^.Marked:=Not OutboundPtr^.Marked;
Inc(MarkCount);
WriteLine(OutboundPtr, Linie,FALSE);
IF Outbound.Next(OutboundPtr)<>Nil THEN StuffKey($5000);
END;
' ' : UnmarkAll;
ELSE CASE InKey OF
Up : IF (OutboundPtr<>Nil) AND (outbound.Prev(OutboundPtr) <> NIL) THEN
BEGIN
WriteLine(OutboundPtr, Linie, FALSE);
Dec(Linie);
OutboundPtr:=OutboundPtrType(outbound.Prev(OutboundPtr));
IF Linie < 2 THEN
BEGIN
FirstLine:=OutboundPtrType(Outbound.Prev(FirstLine));
WriteOutbound;
END ELSE
WriteLine(OutboundPtr,Linie, FALSE);
END;
Down : IF (OutboundPtr <> NIL) AND (outbound.next(OutboundPtr) <> NIL) THEN
BEGIN
WriteLine(OutboundPtr, Linie, FALSE);
Inc(Linie);
OutboundPtr:=OutboundPtrType(outbound.next(OutboundPtr));
IF Linie > ScreenHeight-5 THEN
BEGIN
FirstLine:=OutboundPtrType(Outbound.Next(FirstLine));
WriteOutbound;
END ELSE
WriteLine(OutboundPtr,Linie,FALSE);
END;
PgDn : IF Outbound.Size>0 THEN
BEGIN
l:=2;
WHILE (Outboundptr <> NIL) AND (Outbound.Next(OutboundPtr)<>Nil) And (l<ScreenHeight-4) DO
BEGIN
Inc(linie); Inc(l);
OutboundPtr:=OutboundPtrType(Outbound.next(OutboundPtr));
IF Linie>ScreenHeight-5 THEN
BEGIN
FirstLine:=OutboundPtr;
Linie:=2;
END;
END;
WriteOutbound;
END;
PgUp : IF Outbound.Size>0 THEN
BEGIN
l:=ScreenHeight-4;
WHILE (outboundptr <> NIL) AND (Outbound.Prev(OutboundPtr)<>Nil) And (l>2) DO
BEGIN
Dec(Linie); Dec(l);
OutboundPtr:=OutboundPtrType(Outbound.prev(OutboundPtr));
IF Linie<2 THEN
BEGIN
IF Outbound.Prev(FirstLine)<>Nil THEN FirstLine:=OutboundPtrType(Outbound.prev(FirstLine));
Linie:=2;
END;
END;
WriteOutbound;
END;
Home : IF Outbound.Size>0 THEN
BEGIN
OutboundPtr:=OutboundPtrType(Outbound.Head);
FirstLine:=OutboundPtr;
WriteOutbound;
END;
EndKey:IF Outbound.Size>0 THEN
BEGIN
OutboundPtr:=OutboundPtrType(Outbound.Tail);
FirstLine:=OutboundPtr;
Linie:=ScreenHeight-5;
WHILE (Outbound.Prev(FirstLine)<>Nil) And (Linie>2) DO
BEGIN
Dec(Linie);
FirstLine:=OutboundPtrType(Outbound.Prev(FirstLine));
END;
WriteOutbound;
END;
Del,
F2 : DeleteEntry;
F3 : RequestFile;
Ins,
F4 : SendFile;
F5 : ReAddress;
F6 : ChangeStat;
F7 : ViewFile;
F8 : Poll;
F9 : FileUpdateRequest;
F10 : GlobalCmd;
END;
END;
UNTIL InKey=Esc;
END;
PROCEDURE RenamePkt(CONST Path: PathStr; CONST FName: S12);
VAR
PktHead : TPktHeader;
f : TBufTextFile;
Orig,
Dest : TFidoAddress;
BEGIN
IF f.Init(Path+FName, SOpenread+ShareDenyNone, 10240) THEN
BEGIN
IF f.GetSize>=SizeOf(PktHead) THEN
BEGIN
f.Read(PktHead,SizeOf(PktHead));
f.Done;
GetPktHeadInfo(PktHead,Orig,Dest);
RenameFile(Path+FName, HoldFileName(Dest,TRUE)+'OUT');
END ELSE
f.Done;
END;
END;
PROCEDURE ScanOutbound;
VAR
ss,ZoneOut, OutName : PathStr;
Try, Count : Byte;
t : Char;
f : TBufTextFile;
FName, ext, p, InStr : String;
i, GlobZone, GlobNet, GlobNode, test : Integer;
Srec, Sr1, sr,sr3 : SEARCHREC;
UnDialableRec : TUndialable;
UnDialableFile,
BadWaZOOFile : PSimpDB;
BadWaZOORec : TBadWaZOO;
GotOne : Boolean;
Wait : PWait;
PROCEDURE SearchDir;
VAR
a : Byte;
BEGIN
FindFirst(ZoneOut+'*.PKT',Archive,Sr) ;
IF (DosError=0) And (Confirm('Orphan packets found, rename','Y',13)) THEN
BEGIN
REPEAT
RenamePkt(ZoneOut,Sr.Name);
FindNext(Sr);
Wait^.Animate;
UNTIL DosError<>0;
END;
FindClose(Sr);
FOR a:=1 TO 5 DO
BEGIN
FindFirst(ZoneOut+'*.'+Mail[a]+'UT', archive, sr);
WHILE DOSERROR = 0 DO
BEGIN
IF Sr.Size<>0 THEN
BEGIN
New(OutboundPtr, Init);
IF OutboundPtr<>NIL THEN
BEGIN
WITH OutboundPtr^ DO
BEGIN
Name:=sr.Name;
Address.Zone:=GlobZone;
Address.Zone:=GlobZone;
IF GlobNet=0 THEN
BEGIN
Val('$'+Copy(sr.Name, 1, 4), Address.Net, test);
Val('$'+Copy(sr.Name, 5, 4), Address.Node, test);
Address.Point:=0;
END ELSE
BEGIN
Address.Net:=GlobNet;
Address.Node:=GlobNode;
Val('$'+Copy(sr.Name, 5, 4), Address.Point, test);
END;
stat:=mail[a];
typ:='B';
siz:=sr.size;
END;
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
END;
Wait^.Animate;
FindNext(sr);
END;
FindClose(Sr);
END;
FindFirst(ZoneOut+'*.REQ', archive, sr);
WHILE DOSError = 0 DO
BEGIN
IF (sr.size>0) AND (f.Init(ZoneOut+sr.Name, SOpenread+ShareDenyNone, 10240)) THEN
BEGIN
GotOne:=False;
WHILE NOT f.EoF DO
BEGIN
f.ReadLn(InStr);
InStr:=StUpCase(InStr);
IF (InStr[1] <> ';') AND (Length(InStr) > 0) THEN
BEGIN
GotOne:=True;
t:='R';
Try:=Pos(' ',InStr);
IF (Try>0) And (pos('-', InStr)>Try) THEN t:='O';
IF (Try>0) And (pos('+', InStr)>Try) THEN t:='U';
IF Try >0 THEN InStr:=Copy(InStr, 1, Try-1);
New(OutboundPtr,Init);
IF OutboundPtr<>NIL THEN
BEGIN
WITH OutboundPtr^ DO
BEGIN
FSplit(InStr, p, FName, ext);
Name:=FName+ext;
path:=p;
Address.Zone:=GlobZone;
IF GlobNet=0 THEN
BEGIN
Val('$'+Copy(sr.Name, 1, 4), Address.Net, test);
Val('$'+Copy(sr.Name, 5, 4), Address.Node, test);
Address.Point:=0;
END ELSE
BEGIN
Address.Net:=GlobNet;
Address.Node:=GlobNode;
Val('$'+Copy(sr.Name, 5, 4), Address.Point, test);
END;
typ:=t;
siz:=0;
END;
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
END;
Wait^.Animate;
END;
f.Done;
IF NOT GotOne THEN DeleteFile(ZoneOut+sr.Name);
END;
FindNext(sr);
END;
FindClose(sr);
FOR a:=1 TO 5 DO
BEGIN
FINDFIRST(ZoneOut+'*.'+Attach[a]+'LO', archive, sr);
WHILE DOSERROR = 0 DO
BEGIN
Count:=0;
IF (sr.size>0) AND (f.Init(ZoneOut+sr.Name, SOpenread+ShareDenyNone, 10240)) THEN
BEGIN
WHILE NOT F.EoF DO
BEGIN
f.ReadLn(InStr);
InStr:=StUpCase(InStr);
IF (Length(InStr)>0) AND (InStr[1]<>';') AND (InStr[1]<>'~') THEN
BEGIN
New(OutboundPtr,Init);
IF OutboundPtr<>NIL THEN
BEGIN
IF (InStr[1] = '#') OR (InStr[1] = '^') THEN
BEGIN
OutboundPtr^.DoAfter:=InStr[1];
InStr:=Copy(InStr, 2, Length(InStr) - 1);
END;
WITH OutboundPtr^ DO
BEGIN
FSplit(InStr, p, FName, ext);
Name:=FName+ext;
Address.Zone:=GlobZone;
IF GlobNet=0 THEN
BEGIN
Val('$'+Copy(sr.Name, 1, 4), Address.Net, test);
Val('$'+Copy(sr.Name, 5, 4), Address.Node, test);
Address.Point:=0;
END ELSE
BEGIN
Address.Net:=GlobNet;
Address.Node:=GlobNode;
Val('$'+Copy(sr.Name, 5, 4), Address.Point, test);
END;
stat:=Attach[a];
FINDFIRST(p+FName+ext, AnyFile, Sr1);
IF DOSError=0 THEN siz:=Sr1.size ELSE siz:=0;
FindClose(Sr1);
IF StUpCase(p) = StUpCase(ZoneOut) THEN p:='';
path:=p;
IF p = '' THEN typ:='M' ELSE typ:='F';
END;
Inc(Count);
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
END;
Wait^.Animate;
END;
f.Done;
END;
IF Count=0 THEN
BEGIN
New(OutboundPtr,Init);
IF OutboundPtr<>NIL THEN
BEGIN
WITH OutboundPtr^ DO
BEGIN
Name:='';
path:='';
Address.Zone:=GlobZone;
IF GlobNet=0 THEN
BEGIN
Val('$'+Copy(sr.Name, 1, 4), Address.Net, test);
Val('$'+Copy(sr.Name, 5, 4), Address.Node, test);
Address.Point:=0;
END ELSE
BEGIN
Address.Net:=GlobNet;
Address.Node:=GlobNode;
Val('$'+Copy(sr.Name, 5, 4), Address.Point, test);
END;
stat:=Attach[a];
siz:=0;
typ:='P';
END;
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
END;
FindNext(sr);
END;
FindClose(sr);
END;
END;
BEGIN
New(Wait, Init((ScreenHeight DIV 2)-2, 3, 'Scanning outbound'));
FINDFIRST(cfg.outbound+'.*', Directory, Srec);
OutName:=JustFileName(cfg.outbound);
GlobNet:=0; GlobNode:=0;
WHILE DOSERROR=0 DO
BEGIN
Test:=0;
IF Srec.Name=OutName THEN
GlobZone:=cfg.Addresses[Cfg.MainAdrNum].Zone
ELSE
BEGIN
p:=Copy(Srec.Name, pos('.', Srec.Name)+1, Length(Srec.Name) - pos('.', Srec.Name)+1);
Val('$'+p, GlobZone, test);
IF GlobZone=Cfg.Addresses[Cfg.MainAdrNum].Zone THEN
BEGIN
FindNext(SRec);
Continue;
END;
END;
IF (Test=0) AND (GlobZone<>0) THEN
BEGIN
ZoneOut:=HoldAreaNameMunge(GlobZone,False);
SearchDir;
FindFirst(ZoneOut+'*.PNT',Directory,sr3);
ss:=ZoneOut;
WHILE DosError=0 DO
BEGIN
ZoneOut:=AddBackSlash(ss+Sr3.Name);
Val('$'+Copy(sr3.Name, 1, 4), GlobNet, i);
Val('$'+Copy(sr3.Name, 5, 4), GlobNode, i);
SearchDir;
FindNext(sr3);
END;
FindClose(sr3);
END;
GlobNet:=0; GlobNode:=0;
Wait^.Animate;
FINDNEXT(Srec);
END;
FindClose(SRec);
New(BadWaZOOFile, Open(StartPath+PoPBadWaZooFileName, SizeOf(TBadWaZOO), False));
IF BadWaZOOFile<>Nil THEN
BEGIN
WHILE BadWaZOOFile^.NextRec(BadWaZOORec, NoKeep) DO
BEGIN
WITH BadWaZOORec DO
BEGIN
FindFirst(Cfg.Inbound[BadWaZooRec.NodeStat]+NewName, AnyFile, Sr);
IF DOSError<>0 THEN Sr.Size:=0;
FindClose(Sr);
New(OutboundPtr,Init);
IF OutboundPtr<>NIL THEN
BEGIN
OutboundPtr^.Name:=NewName;
OutboundPtr^.Address:=BadWaZooRec.Address;
OutboundPtr^.stat:=' ';
OutboundPtr^.siz:=FSize;
OutboundPtr^.path:=FName+' ('+Long2Str(Sr.Size)+') -> ';
OutboundPtr^.typ:='W';
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
Wait^.Animate;
END;
END;
Dispose(BadWaZOOFile, Close);
END;
New(UnDialableFile, Open(StartPath+PoPUndialFileName, SizeOf(TUnDialable), False));
IF UnDialableFile<>Nil THEN
BEGIN
WHILE UnDialableFile^.NextRec(UnDialableRec, NoKeep) DO
BEGIN
WITH UnDialableRec DO
BEGIN
New(OutboundPtr,Init);
IF OutboundPtr<>NIL THEN
BEGIN
OutboundPtr^.Name:='';
OutboundPtr^.Address:=UndialableRec.Address;
OutboundPtr^.stat:=' ';
OutboundPtr^.siz:=0;
OutboundPtr^.path:='NoConnect: '+LongIntForm('##',NoConnect)+' BadWaZOO: '+LongIntForm('###',BadWaZOO);
OutboundPtr^.typ:='Z';
InsertEntry;
END ELSE
AddLog('!', 'OutMan: Out of memory');
END;
Wait^.Animate;
END;
Dispose(UnDialableFile, Close);
END;
Dispose(Wait, Done);
END;
BEGIN
FillChar(Call, SizeOf(Call), 0);
IF Not SetInterCom(ICOutman,Call,True) THEN Exit;
Outbound.Init;
WITH cfg.color[2] DO
BEGIN
mywin(Temp, 1, 2, 80, ScreenHeight-2, 2, 'Outbound Manager',False);
Temp^.wFastText(' Address Type Stat Size Filename ', 1, 1);
mywin(Temp3, 1, ScreenHeight-1, 80, ScreenHeight, 2, '',False);
temp3^.wfasttext('F1=Help F2=Delete F3=Request F4=Send File F5=ReAddress', 1, 2);
temp3^.wfasttext('F6=Change Stat F7=View File F8=Poll F9=Upd. Req. F0=Global Cmd.', 2, 2);
END;
ScanOutbound;
Temp^.Select;
OutboundPtr:=OutboundPtrType(OutBound.Head);
FirstLine:=OutboundPtr;
MarkCount:=0;
WriteOutbound;
BrowseList;
KillWindow(Temp3);
KillWindow(Temp);
Outbound.Done;
END;
END.